00100	TITLE III
00200	;	-- DISPLAY SUBROUTINES -- NOVEMBER 1972.
00300
00400	;DISPLAY UUO CODES.
00500		OPDEF DPYPOS [XWD 702100,0]
00600		OPDEF DPYSIZ [XWD 702140,0]
00700		OPDEF DPYCLR [XWD 701000,0]
00800		OPDEF UPG [XWD 703000,0]
00900		OPDEF GETLIN [TTYUUO 6,]
01000
01100
01200	A←1
01300	B←2
01400	C←3
01500
01600	SP←16
01700	
01800
01900	INTERNAL DPYSET,AIVECT,AVECT,APT,RIVECT,RVECT,RPT
02000	INTERNAL APOINT,RPOINT
02100	INTERNAL DPYOUT,HYDPOG
02200	INTERNAL DPYCLR,DPYBIG,DPYBRT,DPYRESET,DPYPARS
02300	INTERNAL CLRBFR,DTYO,DPYSST
02400
02500		RV←←6
02600		AVCO←←106
02700		VIS←←0
02800		EP←←20
02900		INV←←40
03000		SVS←100
03100		SV←2
03200	
03300		DEFINE COMPAT(N)<POP P,RETURN↔JSP COMP-N>
03400	
03500		POP P,5
03600		POP P,4
03700		POP P,3
03800		POP P,2
03900		POP P,1
04000	COMP:	JRST @0
     

00100	;EXTERNAL PROCEDURE AIVECT(INTEGER X,Y)
00200	;EXTERNAL PROCEDURE AVECT(INTEGER X,Y)
00300	;EXTERNAL PROCEDURE APT(INTEGER X,Y)
00400	AIVECT:	MOVEI C,INV+AVCO
00500		GO LV
00600	AVECT:	MOVEI C,VIS+AVCO
00700		GO LV
00800	APOINT:
00900	APT:	MOVEI C,EP+AVCO
01000	LV:	COMPAT(2)
01100		SKIPGE IGNORE↔GO @RETURN
01200	LVC:	DPB A,[POINT 11,C,10]
01300		DPB B,[POINT 11,C,21]
01400	LV2:	AOS A,DPYPTR
01500		DAC C,(A)
01600	LV3:	HRLI A,<(<POINT 7,0,35>)>
01700		DAC A,DPYPTR
01800		HRRZI A,(A)
01900		CAML A,BUFEND
02000		SETOM IGNORE
02100		GO @RETURN
     

00100	;EXTERNAL PROCEDURE RIVECT(INTEGER X,Y)
00200	;EXTERNAL PROCEDURE RVECT(INTEGER X,Y)
00300	;EXTERNAL PROCEDURE RPT(INTEGER X,Y)
00400	RIVECT:	MOVEI C,INV+RV
00500		GO RVG
00600	RVECT:	MOVEI C,VIS+RV
00700		GO RVG
00800	RPOINT:
00900	RPT:	MOVEI C,EP+RV
01000	RVG:	COMPAT(2)
01100		SKIPE RELFLG#
01200		GO LVC
01300		CAML A,[-SVS]
01400		CAIL A,SVS
01500		GO LVC
01600		CAML B,[-SVS]
01700		CAIL B,SVS
01800		GO LVC
01900		ANDCMI C,RV	;CAN CONSTRUCT SHORT VECTOR
02000		DPB A,[POINT 7,C,22]
02100		DPB B,[POINT 7,C,29]
02200		LSH C,20
02300		ORI C,SV+INV	;MAKE 2ND VECTORE INVISIBLE - ZERO LENGTH
02400		LAC A,@DPYPTR
02500		TLZ A,777774
02600		CAIE A,(C);WAS LAST DPY OUTPUT HALF A SHORT VECTOR.
02700		GO LV2	;NO
02800		LSH C,-24	;YES, PUT IT THERE
02900		DPB C,[POINT 16,@DPYPTR,31]
03000		HRRZ A,DPYPTR
03100		GO @RETURN
03200	
03300	INTERNAL NORELOPT,RELOPT
03400	NORELOPT:SETOM RELFLG
03500		POPJ P,
03600	
03700	RELOPT:	SETZM RELFLG
03800		POPJ P,
     

00100	;EXTERNAL PROCEDURE DTYO(INTEGER CHAR)
00200	;EXTERNAL PROCEDURE DPYSST(STRING S);
00300	
00400	DTYO:	COMPAT(1)
00500		IDPB A,DPYPTR
00600		HRRZ A,DPYPTR
00700		CAML A,BUFEND
00800		SETOM IGNORE
00900		GO @RETURN
01000	
01100	DPYSST:	POP SP,1
01200		POP SP,2
01300		SKIPGE IGNORE↔POPJ P,
01400		HRRZS 2		;LENGTH
01500		JUMPLE 2,SSRET
01600		ILDB 3,1
01700		IDPB 3,DPYPTR
01800		SOJG 2,.-2
01900	SSRET:	HRRZ 1,DPYPTR
02000		CAML 1,BUFEND
02100		SETOM IGNORE
02200		POPJ P,
     

00100	DPYBIG:	COMPAT(1)
00200		MOVEI 3,INV+RV	;ZERO LENGTH RELATIVE-INVISIBLE VECTOR
00300		DPB 1,[POINT 3,3,27]
00400		GO LV2
00500	DPYBRT:	COMPAT(1)
00600		MOVEI 3,INV+RV
00700		DPB 1,[POINT 3,3,24]
00800		GO LV2
00900	DPYCLR:	SKIPL DPYFLG#
01000		DPYCLR
01100		MOVSI 777774
01200		DAC POGWD
01300		SETZM BUFHD
01400		POPJ P,
01500	DPYOUT:	PUSHJ P,DPYPARS
01600		HRRZ B,DPYPTR
01700		SUB B,BUFHD
01800		ADDI B,1
01900		DAC B,BUFHD+1
02000	SH2:	COMPAT(1)
02100		DPB A,[POINT 4,SH1,12]
02200		OR A,DPYFLG
02300		SKIPL A
02400	SH1:	UPG BUFHD
02500	FALSE:	MOVEI A,0
02600		GO @RETURN
02700	
02800	CLRBFR:	COMPAT(0)
02900		GO CLR2
03000	
03100	DPYSET:	SETZM DPYFLG
03200		COMPAT(1)
03300		ADDI 1,2
03400		DAC 1,BUFHD
03500		HRRZ 2,-3(1)	;SIZE
03600		ADDI 2,-3(1)
03700		SUBI 2,1
03800		SETZM IGNORE
03900		DAC 2,BUFEND
04000	CLR2:	LAC A,BUFHD
04100		MOVEI B,1
04200		DAC B,1(A)
04300		MOVEI B,2(A)
04400		HRLI B,1(A)
04500		BLT B,@BUFEND	;SET DPY BUFFER TO NULL CHARACTER WORDS
04600		GO LV3
     

00100	HYDPOG:	SETZM BUFHD+1
00200		GO SH2
00300
00400	DPYPARS:	SKIPN 1,BUFHD
00500		POPJ P,
00600		LAC 2,DPYPTR
00700		DAC 2,-2(1)
00800		MOVEI 2,2(2)
00900		SUB 2,1
01000		DAC 2,-1(1)
01100		POPJ P,
01200	
01300	DPYRESET:	COMPAT(1)
01400		ADDI 1,2
01500		DAC 1,BUFHD
01600		HRRZ 2,-3(1)
01700		ADDI 2,-3(1)
01800		DAC 2,BUFEND
01900		HRRZ 1,-2(1)
02000		GO CLR2+1
02100	
02200	INTERNAL DPYTYP,TYPLOC
02300	DPYTYP:	SETZM DPYFLG
02400		COMPAT(3)
02500		SKIPGE DPYFLG
02600		GO @RETURN
02700		DPYPOS(1)	;POSITION
02800		DPB 2,[POINT 9,3,26]
02900		DPYSIZ (3)
03000		GO @RETURN
03100	
03200	TYPLOC:	SETZM DPYFLG
03300		COMPAT(2)
03400		SKIPGE DPYFLG
03500		GO @RETURN
03600		DPYPOS (1)
03700		SUB 1,2
03800		IDIVI 1,=23
03900		CAIG 1,2
04000		MOVEI 1,3
04100		DPYSIZ 1000-2(1)
04200		GO @RETURN
     

00100	INTERNAL PGSEL,GETPOG,RELPOG
00200	PGSEL:	COMPAT(1)
00300		JUMPL 1,@RETURN
00400		SKIPL DPYFLG
00500		PGSEL 1
00600		GO @RETURN
00700	
00800	
00900	POGWD:	XWD 777774,0
01000	
01100	GETPOG:	LAC POGWD
01200		JFFO .+2
01300		MOVNI 1,1
01400		ROT (1)
01500		TLZ 400000
01600		MOVN 2,1
01700		ROT(2)
01800		DAC POGWD
01900		POPJ P,
02000	
02100	RELPOG:	LAC 1,-1(P)
02200		LAC POGWD
02300		ROT (1)
02400		TLO 400000
02500		MOVN 2,1
02600		ROT(2)
02700		DAC POGWD
02800		GO HYDPOG
02900	IGNORE:	0
03000	
03100	RETURN:	0
03200	
03300	
03400	INTERNAL DPYPTR;
03500	DPYPTR:	0
03600	BUFEND:	0
03700	BUFHD:	0
03800		0
     

00100	;CLIPER  -  2D LINE SEGMENT CLIPPER  -  AUGUST 1972.
00200	
00300	DPYBUF:	DPYBU.
00400		=1024↔1↔XWD 1,=1024
00500	DPYBU.: BLOCK 2000
00600	
00700		INTERN MAG,SX,SY,SOX,SOY,DEL
00800	;SOURCE WINDOW.
00900		SX:	0
01000		SY:	0
01100		SOX:	0
01200		SOY:	0
01300	
01400	;OBJECT WINDOW.
01500		OX:	0
01600		OY:	0
01700		MAG:	3.4
01750		DEL:	32.0
01800	
01900	;PSEUDO BEAM POSITION.
02000		XXX:	0
02100		YYY:	0
02200	
02300	
02400		DECLARE{XL,XH,YL,YH}
02500	
02600	SUBR(CROP)
02700	BEGIN CLIPIN
02800		LAC 1,OX↔LAC MAG↔FMP SX↔FSB 1,0↔DAC 1,SOX
02900		LAC 1,OY↔LAC MAG↔FMP SY↔FSB 1,0↔DAC 1,SOY
03000	
03100		LAC 1,OX↔LAC MAG↔FMP[155.0]↔FSB 1,0
03200		CAMG 1,[-510.0]↔LAC 1,[-510.0]↔DAC 1,XL
03300		LAC 1,OX↔LAC MAG↔FMP[155.0]↔FAD 1,0
03400		CAML 1,[ 510.0]↔LAC 1,[510.0]↔DAC 1,XH
03500	
03600		LAC 1,OY↔LAC MAG↔FMP[115.0]↔FSB 1,0
03700		CAMG 1,[-470.0]↔LAC 1,[-470.0]↔DAC 1,YL
03800		LAC 1,OY↔LAC MAG↔FMP[115.0]↔FAD 1,0
03900		CAML 1,[ 470.0]↔LAC 1,[470.0]↔DAC 1,YH
04000	
04100		POP0J
04200	BEND
04300	
     

00100	SUBR(AI)
00200	BEGIN AI
00300		LAC ARG2↔FMP MAG↔FAD SOX↔DAC XXX
00400		LAC ARG1↔FMP MAG↔FAD SOY↔DAC YYY
00500		POP2J
00600	BEND
00700	
00800	SUBR(AV)
00900	BEGIN AV
01000		GO .+5
01100		X1:0↔Y1:0↔X2:0↔Y2:0	;FUCKING REFERENCE REALS.
01200		LAC XXX↔DAC X1
01300		LAC YYY↔DAC Y1
01400		LAC ARG2↔FMP MAG↔FAD SOX↔DAC XXX↔DAC X2
01500		LAC ARG1↔FMP MAG↔FAD SOY↔DAC YYY↔DAC Y2
01600		MOVEI X1↔PUSH 17,
01700		MOVEI Y1↔PUSH 17,
01800		MOVEI X2↔PUSH 17,
01900		MOVEI Y2↔PUSH 17,
02000		PUSHJ P,CLIP
02100		SKIPN 1↔POP2J
02200		LAC X1↔FIXX↔PUSH P,
02300		LAC Y1↔FIXX↔PUSH P,
02400		PUSHJ P,AIVECT
02500		LAC X2↔FIXX↔PUSH P,
02600		LAC Y2↔FIXX↔PUSH P,
02700		PUSHJ P,AVECT
02800		POP2J
02900	BEND
     

00100	GETXY:	0
00200	
00300		CDR -1(1)	;COL TO X.
00400		SUBI =144*=64
00500		FSC 225↔PUSH P,
00600	
00700		CAR 2,-1(1)	;ROW TO Y.
00800		MOVEI =108*=64
00900		SUB 0,2
01000		FSC 225↔PUSH P,
01100		GO @GETXY
01200	
01300	SUBR DPYPGON
01400	BEGIN
01500		LAC 1,ARG1
01600		CAR 1,1(1)↔DAC 1,E0#
01700		CAR 1,1(1)↔JSR GETXY ↔ PUSHJ P,AI	; V0 ← CW(E0).
01800		LAC 1,E0↔CDR 1,1(1)↔DAC 1,V#
01900	
02000	L1:	JSR GETXY ↔ PUSHJ P,AV
02100		LAC 1,V
02200		CDR 1,1(1)	;E
02300		CAMN 1,E0↔POP1J
02400		CDR 1,1(1)
02500		DAC 1,V
02600		GO L1
02700		POP1J
02800	BEND
     

00100	SUBR(REFRESH)
00200	BEGIN
00300		EXTERN PGON0
00400		CALL(DPYSET,DPYBUF)
00500		PUSH P,[-=510]↔PUSH P,[-=470]↔PUSHJ P,AIVECT
00600		PUSH P,[ =510]↔PUSH P,[-=470]↔PUSHJ P,AVECT
00700		PUSH P,[ =510]↔PUSH P,[ =470]↔PUSHJ P,AVECT
00800		PUSH P,[-=510]↔PUSH P,[ =470]↔PUSHJ P,AVECT
00900		PUSH P,[-=510]↔PUSH P,[-=470]↔PUSHJ P,AVECT
01000		LAC 1,PGON0↔DAC 1,PGON#
01100	L1:	CDR 1,2(1)
01200		DAC 1,PGON
01300		PUSH P,1↔PUSHJ P,DPYPGON
01400		LAC 1,PGON
01500		CAME 1,PGON0
01600		GO L1
01700		SETZ↔PUSH P,↔PUSHJ P,DPYOUT
01800		POP0J
01900	BEND
     

00100	; FLG ← CLIP(X1,Y1,X2,Y2) RETURN TRUE WHEN PORTION IS VISIBLE.
00200	DECLARE{AAA,BBB,CCC,FLGO,FLGZ,AXH,AXL,BYH,BYL,QNE,QNW,QSW,QSE}
00300	SUBR(CLIP)
00400	BEGIN CLIP
00500		ACCUMULATORS{X1,Y1,X2,Y2,PDL}
00600		PTR←13
00700	
00800	;PICK 'EM UP;
00900		LAC X1,@ARG4↔LAC Y1,@ARG3
01000		LAC X2,@ARG2↔LAC Y2,@ARG1
01100		LACI PTR,PDL-1
01200	
01300	;SET NSEW BITS.
01400		SETZB 1
01500		CAMLE Y1,YH↔TRO 8↔CAMLE Y2,YH↔TRO 1,8;	NORTH.
01600		CAMGE Y1,YL↔TRO 4↔CAMGE Y2,YL↔TRO 1,4;	SOUTH.
01700		CAMLE X1,XH↔TRO 2↔CAMLE X2,XH↔TRO 1,2;	EAST.
01800		CAMGE X1,XL↔TRO 1↔CAMGE X2,XL↔TRO 1,1;	WEST.
01900	
02000	;EASY OUTSIDER EDGE.
02100		TRNE 0,(1)↔GO [OUTSIDE: SETZ 1,↔POP4J]
02200	
02300	;EASY INSIDER VERTICES.
02400		JUMPE 0,[PUSH PTR,X1↔PUSH PTR,Y1↔GO .+1]
02500		JUMPE 1,[PUSH PTR,X2↔PUSH PTR,Y2↔GO .+1]
02600		DEFINE DONE{CAMN PTR,[XWD 4,PDL+3]↔GO L}
02700		DONE
     

00100	;COMPUTE EDGE COEFFICIENTS.
00200		LAC Y1↔FSBR Y2↔DAC AAA
00300		LAC X2↔FSBR X1↔DAC BBB
00400		LAC X2↔FMPR Y1↔MOVNM CCC
00500		LAC X1↔FMPR Y2↔FADRM CCC
00600	
00700	;PARTIAL PRODUCTS.
00800		LAC AAA↔FMPR XH↔DAC AXH
00900		LAC AAA↔FMPR XL↔DAC AXL
01000		LAC BBB↔FMPR YH↔DAC BYH
01100		LAC BBB↔FMPR YL↔DAC BYL
01200	
01300	;CORNER Q'S.
01400		SETOM FLGO↔SETZM FLGZ
01500		LAC AXH↔FADR BYH↔FADR CCC↔DAC QNE↔ANDM FLGO↔IORM FLGZ
01600		LAC AXL↔FADR BYH↔FADR CCC↔DAC QNW↔ANDM FLGO↔IORM FLGZ
01700		LAC AXL↔FADR BYL↔FADR CCC↔DAC QSW↔ANDM FLGO↔IORM FLGZ
01800		LAC AXH↔FADR BYL↔FADR CCC↔DAC QSE↔ANDM FLGO↔IORM FLGZ
01900	
02000	;HARD OUTSIDER CASES.
02100		SKIPGE FLGO↔GO OUTSIDE
02200		SKIPL  FLGZ↔GO OUTSIDE
     

00100	;XY-CLIPPER continued.
00200	;NORTH BORDER CROSSING.
00300		LAC QNE↔XOR QNW↔SKIPL↔GO L2
00400		LAC Y1↔CAMGE Y2↔LAC Y2↔CAMG YH↔GO L2
00500		LAC BYH↔FADR CCC↔MOVNS↔FDVR AAA↔PUSH PTR,
00600		LAC YH↔PUSH PTR,
00700		DONE
00800	
00900	;SOUTH BORDER CROSSING.
01000	L2:	LAC QSE↔XOR QSW↔SKIPL↔GO L3
01100		LAC Y1↔CAMLE Y2↔LAC Y2↔CAML YL↔GO L3
01200		LAC BYL↔FADR CCC↔MOVNS↔FDVR AAA↔PUSH PTR,
01300		LAC YL↔PUSH PTR,
01400		DONE
01500	
01600	;EAST BORDER CROSSING.
01700	L3:	LAC QSE↔XOR QNE↔SKIPL↔GO L4
01800		LAC X1↔CAMGE X2↔LAC X2↔CAMG XH↔GO L4
01900		LAC XH↔PUSH PTR,
02000		LAC AXH↔FADR CCC↔MOVNS↔FDVR BBB↔PUSH PTR,
02100		DONE
02200	
02300	;WEST BORDER CROSSING.
02400	L4:	LAC QSW↔XOR QNW↔SKIPL↔GO L5
02500		LAC X1↔CAMLE X2↔LAC X2↔CAML XL↔GO L5
02600		LAC XL↔PUSH PTR,
02700		LAC AXL↔FADR CCC↔MOVNS↔FDVR BBB↔PUSH PTR,
02800		DONE
02900	
03000	;STRANGE EXIT - NSEW BIT MARKING & EDGE COEF ARE INCONSISTENT.
03100	L5:	OUTSTR[ASCIZ/2D CLIPPER FALL THRU !
03200	/]↔	GO OUTSIDER
03300	
03400	;VISIBLE PORTION EXIT.
03500	L:	DAC X1+4,@ARG4↔DAC Y1+4,@ARG3
03600		DAC X2+4,@ARG2↔DAC Y2+4,@ARG1
03700		SETO 1,↔POP4J
03800		LIT
03900	BEND
     

00100	INTERN HISTO
00200	
00300	HISTO:	HISTO.
00400		=65
00500		1
00600		XWD -1,64
00700	HISTO.:	BLOCK =68
00800	
00900	;DISPLAY HISTOGRAM.
01000	SUBR(DPYHIS)
01100	BEGIN DPYHIS
01200		CALL(DPYSET,DPYBUF)
01300		MOVEI 1,1
01400		CALL(DPYBIG,1)
01500	;SCALE THE IMAGE TO ITS LARGEST COLUMN.
01600		SETZ
01700		LAC 1,HISTO↔HRLI 1,-100
01800		CAMGE 0,(1)↔LAC(1)↔AOBJN 1,.-2
01900		MOVE 1,[800.0]↔FSC 233↔FDV 1,0↔DAC 1,SY#
02000	
02100		PUSH P,[=511]↔PUSH P,[-=400]↔PUSHJ P,AIVECT
02200		PUSH P,[-=511]↔PUSH P,[-=400]↔PUSHJ P,AVECT
02300	
02400		LAC 13,HISTO↔HRLI 13,-100
02500		MOVEI =511↔DACN 10	;X.
02600	
02700	L:	PUSH P,10↔ADDI 10,20
02800		LAC 11,(13)↔FSC 11,233↔FMP 11,SY↔FIX 11,233000
02900		SUBI 11,=400↔PUSH P,11
03000		PUSHJ P,AVECT
03100		CALL(AVECT,10,11)
03200		AOBJN 13,L
03300	
03400		PUSH P,[=511]↔PUSH P,[-=400]↔PUSHJ P,AVECT
03500		PUSH P,[0]↔PUSHJ P,DPYOUT
03600		POP0J
03700	BEND
03800	END